home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbrowser / vbrowser.bas < prev    next >
BASIC Source File  |  1995-10-24  |  29KB  |  823 lines
  1. Declare Function getmodulehandle% Lib "Kernel" (ByVal lpModuleName$)
  2. Declare Function lstrcpy& Lib "Kernel" (ByVal dststring As Any, ByVal srcstring As Any)
  3. Declare Sub hmemcpy Lib "Kernel" (dst As Any, src As Any, ByVal bytecount As Long)
  4.  
  5.  
  6.  
  7. Global debugging
  8. Global cr$, lf$, crlf$, crlfcrlf$, lflf$
  9. Global quit_flag
  10. Global main_hwnd%           'Handle of main window to where
  11.                             'WSAAsync NAME messages are sent. Msgblast
  12.                             'will intercept them.
  13. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  14. Global name_msg%            'Message number of any get name request
  15. Global got_name_response    'Flag that indicates WSAsync Name call
  16.                             'got a message(response).
  17. Global event_error%         'Hiword is returned error code, if any.
  18. Global event_type%          'Loword is event type.
  19. Global event_wparam%        'Returned handle of caller
  20. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  21. Global event_msg%           'Message number for a ASYNC event.
  22. Global server_addr&
  23. Global server_domain$
  24. Global server_dotaddr$
  25. Global document$            'Document to get from server
  26. Global current_msg$         'Current received message
  27. Global current_header$      'Current header after split routine
  28. Global callsocket%          'Current socket(handle) assigned
  29.                             'to the server
  30.  
  31. Global closed
  32. Global urls$(), numurls, urlnum
  33.  
  34. '''''''''''''''''''''''''''''''''''''''''''''''''''''
  35. 'Winsock declarations needed for VBrowser
  36.  
  37. Type sockaddr_in_type
  38.   sin_family As Integer
  39.   sin_port As Integer
  40.   sin_addr As Long
  41.   sin_zero As String * 8
  42. End Type
  43. Global call_sockaddr_in As sockaddr_in_type
  44.  
  45. Type WSAdata_type
  46.    wVersion As Integer
  47.    wHighVersion As Integer
  48.    szDescription As String * 257
  49.    szSystemStatus As String * 129
  50.    iMaxSockets As Integer
  51.    iMaxUdpDg As Integer
  52.    lpVendorInfo As String * 200
  53. End Type
  54. Global WSAdata As WSAdata_type
  55.  
  56. Type namehostent_type               'Where Winsock, after
  57.     h_name As Long                  'WSAAsyncGetHostByAddr/Name
  58.     h_aliases As Long               'places the hostent data.
  59.     h_addrtype As Integer           'Winsock also palces the data
  60.     h_length As Integer             'pointed to by these pointers
  61.     h_addr_list As Long             'at the end of the hostent data.
  62.     buff As String * 100            'The data 'pointed' to by the
  63.                                     'above pointers.
  64. End Type
  65. Global namehostent As namehostent_type
  66.  
  67. Type sockopt_bool_type               'Used for setting socket options
  68.   val As Integer
  69. End Type
  70. Global sockopt_bool As sockopt_bool_type
  71.  
  72. 'Winsock calls in VB format
  73. Declare Function bind Lib "winsock.dll" (ByVal s As Integer, addr As sockaddr_in_type, ByVal namelen As Integer) As Integer
  74. Declare Function inet_addr Lib "winsock.dll" (ByVal s As String) As Long
  75. Declare Function gethostbyname Lib "winsock.dll" (ByVal hostname As String) As Long
  76. Declare Function gethostbyaddr Lib "winsock.dll" (hostaddress As Long, ByVal lenaddress As Integer, ByVal pftype As Integer) As Long
  77. Declare Function inet_ntoa Lib "winsock.dll" (ByVal iaddr As Long) As Long
  78. Declare Function socket Lib "winsock.dll" (ByVal af As Integer, ByVal typesock As Integer, ByVal protocol As Integer) As Integer
  79. Declare Function connect Lib "winsock.dll" (ByVal sock As Integer, sockstruct As sockaddr_in_type, ByVal structlen As Integer) As Integer
  80. Declare Function send Lib "winsock.dll" (ByVal sock As Integer, ByVal msg As String, ByVal msglen As Integer, ByVal flag As Integer) As Integer
  81. Declare Function recv Lib "winsock.dll" (ByVal sock As Integer, ByVal msg As String, ByVal msglen As Integer, ByVal flag As Integer) As Integer
  82. Declare Function closesocket Lib "winsock.dll" (ByVal sock As Integer) As Integer
  83. Declare Function setsockopt Lib "winsock.dll" (ByVal sock As Integer, ByVal level As Integer, ByVal optname As Integer, optval As sockopt_bool_type, ByVal optlen As Integer) As Integer
  84. Declare Function htons Lib "winsock.dll" (ByVal a As Integer) As Integer
  85.  
  86. 'These are the Win specific calls which use messages
  87. Declare Function WSAStartup Lib "winsock.dll" (ByVal a As Integer, b As WSAdata_type) As Integer
  88. Declare Function WSACleanup Lib "winsock.dll" () As Integer
  89. Declare Function WSAAsyncSelect Lib "winsock.dll" (ByVal sock As Integer, ByVal hWnd As Integer, ByVal msg As Integer, ByVal event As Long) As Integer
  90. Declare Function WSAGetLastError Lib "winsock.dll" () As Integer
  91. Declare Function WSAAsyncGetHostByAddr Lib "winsock.dll" (ByVal hWnd As Integer, ByVal msg As Integer, hostaddr As Long, ByVal lenhostaddr As Integer, ByVal pftype As Integer, namehostent As namehostent_type, ByVal lenstruc As Integer) As Integer
  92. Declare Function WSAAsyncGetHostByName Lib "winsock.dll" (ByVal hWnd As Integer, ByVal msg As Integer, ByVal hostname As String, namehostent As namehostent_type, ByVal lenanmehostent As Integer) As Integer
  93.  
  94. 'Some constants declarations
  95. Global Const SOCKET_ERROR = -1
  96. Global Const INVALID_SOCKET = -1
  97.  
  98. Global Const SOCK_STREAM = 1
  99. Global Const AF_INET = 2
  100. Global Const PF_INET = 2
  101.  
  102. Global Const IPPROTO_TCP = 6
  103. Global Const SOL_SOCKET = &HFFFF
  104. Global Const SO_DEBUG = &H1
  105. Global Const SO_ACCEPTCONN = &H2
  106. Global Const SO_REUSEADDR = &H4
  107. Global Const SO_KEEPALIVE = &H8
  108. Global Const SO_DONTROUTE = &H10
  109. Global Const SO_BROADCAST = &H20
  110. Global Const SO_USELOOPBACK = &H40
  111. Global Const SO_LINGER = &H80
  112. Global Const SO_OOBINLINE = &H100
  113. Global Const SO_DONTLINGER = &HFF7F
  114.  
  115. Global Const AF_UNSPEC = 0
  116.  
  117. Global Const FD_READ = 1
  118. Global Const FD_WRITE = 2
  119. Global Const FD_OOB = 4
  120. Global Const FD_ACCEPT = 8
  121. Global Const FD_CONNECT = &H10
  122. Global Const FD_CLOSE = &H20
  123.  
  124. Function ask_server (req_msg$)
  125. DoEvents
  126. mlen = Len(req_msg$)
  127. 'Clear the inbound message buffer
  128. current_msg$ = ""
  129. dprint "Send request"
  130. send_next_segment:
  131. status% = send(callsocket%, req_msg$, mlen, 0)
  132. If status% = SOCKET_ERROR Then
  133.     status% = WSAGetLastError()
  134.     dprint "Send ERROR " & sockerror$(status%)
  135.     GoTo exit_ask_server
  136. ElseIf status% = mlen Then
  137.     dprint "Send was OK...waiting for response."
  138. Else
  139.     dprint "Partial send of " & mlen & " bytes"
  140.     req_msg$ = Mid$(req_msg$, status% + 1)
  141.     mlen = Len(req_msg$)
  142.     GoTo send_next_segment
  143. End If
  144. 'Now wait for the response from the server.
  145. 'Keep trying to receive until the server disconnects.
  146. 'At that time the receive will fail
  147. Do
  148.     DoEvents
  149.     'We should also place a timeout routine...just in
  150.     'case. I'll let you write that.
  151.     If quit_flag Then
  152.         Exit Do
  153.     End If
  154.     If closed Then
  155.         'Msgblast routine dprints the close message and
  156.         'sets the global flag 'closed'
  157.         dprint "Closed received"
  158.         Exit Do
  159.     End If
  160. Loop
  161. status% = close_sock(callsocket%)
  162. callsocket% = 0
  163. 'Current_msg$ is global and is where the receive event
  164. 'code in Msgblast placed the received data.
  165. ok = True
  166. exit_ask_server:
  167. ask_server = ok
  168. End Function
  169.  
  170. Sub call_server (n$)
  171. browserfrm.Text1.Text = ""
  172. If get_server_address(n$) Then
  173.     If get_callsock() Then
  174.         If connect_server() Then
  175.             'ask for document
  176.             If Len(document$) = 0 Then
  177.                 'The operator did't ask for a specific
  178.                 'document, so use the HTTP standard request
  179.                 'for the server root directory. It will return
  180.                 'its 'index.htm'.
  181.                 document$ = "/"
  182.             End If
  183.             browserfrm.url.Caption = "http://" + server_domain$ + document$
  184.             msg$ = "GET " + document$ + " HTTP/1.0" + crlf$
  185.             msg$ = msg$ + "Accept: */*" + crlf$
  186.             msg$ = msg$ + "Accept: text/html" + crlf$
  187.             msg$ = msg$ + crlf$
  188.             browserfrm.Text1.Text = "Our request:" + crlfcrlf$ + msg$
  189.             If ask_server(msg$) Then
  190.                 'Places received message in current_msg$
  191.                 parse_current_msg
  192.             End If
  193.         End If
  194.     End If
  195. Else
  196.     'Invalid name or can't get DNS resolution of
  197.     'User entered server do